home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Visual Basic Source Code
/
Visual Basic Source Code.iso
/
vbsource
/
dump_s1r
/
colorsel.frm
(
.txt
)
< prev
next >
Wrap
Visual Basic Form
|
1998-12-19
|
6KB
|
208 lines
VERSION 5.00
Begin VB.Form frmColorSelector
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
ClientHeight = 3255
ClientLeft = 45
ClientTop = 330
ClientWidth = 3975
FillColor = &H8000000F&
Icon = "ColorSel.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3255
ScaleWidth = 3975
ShowInTaskbar = 0 'False
StartUpPosition = 2 'CenterScreen
Begin VB.PictureBox P1
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 2235
Left = 0
ScaleHeight = 2235
ScaleWidth = 3705
TabIndex = 0
Top = 0
Width = 3705
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
ForeColor = &H80000008&
Height = 240
Left = 3450
ScaleHeight = 210
ScaleWidth = 210
TabIndex = 1
Top = 240
Width = 240
End
End
Attribute VB_Name = "frmColorSelector"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public Color As Long
Private Colors(1 To 48) As Long
Private Circ As Collection
Private WithEvents cmdOK As ComboPack.Button
Attribute cmdOK.VB_VarHelpID = -1
Private WithEvents cmdCancel As ComboPack.Button
Attribute cmdCancel.VB_VarHelpID = -1
Private Sub cmdCancel_Click()
End Sub
Private Sub cmdOK_Click()
Color = Picture1.BackColor
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK.MouseDown Button, X, Y
cmdCancel.MouseDown Button, X, Y
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdCancel.MouseMove Button, X, Y
cmdOK.MouseMove Button, X, Y
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
cmdOK.MouseUp Button, X, Y
cmdCancel.MouseUp Button, X, Y
'\\//'
End Sub
Private Sub cmdOK_Press()
cmdOK.HasFocus = True
cmdCancel.HasFocus = False
End Sub
Private Sub cmdCancel_Press()
cmdCancel.HasFocus = True
cmdOK.HasFocus = False
End Sub
Private Sub Form_Load()
Dim L1 As Long, L2 As Long
SetColors
Set cmdOK = New ComboPack.Button
Set cmdOK.Parent = frmColorSelector
cmdOK.Left = Width / 2 - 562.5
cmdOK.Top = 2310
cmdOK.Height = 405
cmdOK.Width = 1125
cmdOK.ForeColor = 0
cmdOK.BackColor = -2147483633
cmdOK.Name = "cmdOK"
cmdOK.Caption = "OK"
cmdOK.Redraw
cmdOK.Enabled = True
cmdOK.HasFocus = True
Set cmdCancel = New ComboPack.Button
Set cmdCancel.Parent = frmColorSelector
cmdCancel.Left = Width / 2 - 562.5
cmdCancel.Top = 2730
cmdCancel.Height = 405
cmdCancel.Width = 1125
cmdCancel.ForeColor = 0
cmdCancel.BackColor = -2147483633
cmdCancel.Name = "cmdCancel"
cmdCancel.Caption = "Cancel"
cmdCancel.Redraw
cmdCancel.Enabled = True
Set Circ = New Collection
Dim cCirc As clsCircle
Dim Color As Byte
For L1 = 1 To 9
For L2 = 1 To 5
Set cCirc = New clsCircle
Draw3DCircle P1, 240 + (360 * L1) - 240, 240 + (360 * L2) - 240, 120, Colors(Color + 1), True, True
cCirc.Color = Colors(Color + 1)
cCirc.Left = 240 + (360 * L1) - 360
cCirc.Top = 240 + (360 * L2) - 360
cCirc.Size = 240
Circ.Add cCirc
Color = Color + 1
'Clipboard.Clear
'Clipboard.SetText BtnMngrToCode(CommandToCls(Me))
SetColor Picture1.BackColor
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim clsCircle As clsCircle
Dim Found As Boolean
For Each clsCircle In Circ
If X > clsCircle.Left And X < clsCircle.Left + clsCircle.Size And Y > clsCircle.Top And (Y < clsCircle.Top + clsCircle.Size) Then
Found = True
End If
If Not Found Then Exit Sub
P1.Cls
For Each clsCircle In Circ
Draw3DCircle P1, clsCircle.Left + 120, clsCircle.Top + 120, 120, clsCircle.Color, True, True
For Each clsCircle In Circ
If X > clsCircle.Left And X < clsCircle.Left + clsCircle.Size And Y > clsCircle.Top And (Y < clsCircle.Top + clsCircle.Size) Then
Picture1.BackColor = clsCircle.Color
DrawMode = 6
DrawCross P1, clsCircle.Left, clsCircle.Top, QBColor(15)
DrawMode = 13
End If
End Sub
Public Sub SetColor(Color As Long)
Dim clsCircle As clsCircle
P1.Cls
For Each clsCircle In Circ
Draw3DCircle P1, clsCircle.Left + 120, clsCircle.Top + 120, 120, clsCircle.Color, True, True
For Each clsCircle In Circ
If clsCircle.Color = Color Then
DrawCross P1, clsCircle.Left, clsCircle.Top, QBColor(15)
End If
End Sub
Private Sub SetColors()
Colors(1) = &HFFFFFF
Colors(2) = &HE0E0E0
Colors(3) = &HC0C0C0
Colors(4) = &H808080
Colors(5) = &H404040
Colors(6) = &HC0C0FF
Colors(7) = &H8080FF
Colors(8) = &HFF&
Colors(9) = &HC0&
Colors(10) = &H80&
Colors(11) = &H40&
Colors(12) = &HC0E0FF
Colors(13) = &H80C0FF
Colors(14) = &H80FF&
Colors(15) = &H40C0&
Colors(16) = &H80C0FF
Colors(17) = &H4080&
Colors(18) = &H404080
Colors(19) = &HC0FFFF
Colors(20) = &H80FFFF
Colors(21) = &HFFFF&
Colors(22) = &HC0C0&
Colors(23) = &H8080&
Colors(24) = &HC0FFC0
Colors(25) = &H80FF80
Colors(26) = &HFF00&
Colors(27) = &HC000&
Colors(28) = &H8000&
Colors(29) = &HFFFFC0
Colors(30) = &HFFFF80
Colors(31) = &HFFFF00
Colors(32) = &HC0C000
Colors(33) = &H808000
Colors(34) = &HFFC0C0
Colors(35) = &HFF8080
Colors(36) = &HFF0000
Colors(37) = &HC00000
Colors(38) = &H800000
Colors(39) = &HFFC0FF
Colors(40) = &HFF80FF
Colors(41) = &HFF00FF
Colors(42) = &HC000C0
Colors(43) = &H800080
Colors(44) = &HC0E0FF
Colors(45) = &H8000000D
Colors(46) = &H8000000E
Colors(47) = &H8000000F
Colors(48) = &H80000010
End Sub